home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STRINGS.SWG / 0081_General String Library.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  23KB  |  622 lines
  1. UNIT STR_STF;
  2.   {**------------------------------------------------**}
  3.   {**    STRING Library OPERATIONS                   **}
  4.   {**    Version 1.2                                 **}
  5.   {**            Added Pos_Reverse                   **}
  6.   {**    Version 1.1 (sped-ups)                      **}
  7.   {**                (delete_duplicate_Chars_in_str) **}
  8.   {**            Added Int_To_Str_Zero_Fill          **}
  9.   {**------------------------------------------------**}
  10.  
  11. {$O-,F+}
  12.  
  13. INTERFACE
  14. {**************************************************************}
  15. {* Trim   removes leading/trailing blanks.                    *}
  16. {*                                                            *}
  17. {**************************************************************}
  18. FUNCTION TRIM        (Str : string) : string;
  19.  
  20. FUNCTION TRIM_Leading_Only (Str : string) : string;
  21. FUNCTION TRIM_Trailing_Only (Str : string) : string;
  22. FUNCTION TRIM_Quotes (Str : string) : string;
  23.  
  24. {**************************************************************}
  25. {* Right_Justify adds leading blanks.                         *}
  26. {*    NOTE: does not handle cases when                        *}
  27. {*                   Size_To_Be < ACTUAL NUMBER OF CHARACTERS *}
  28. {**************************************************************}
  29. FUNCTION Right_Justify (Str : string; Size_To_Be : integer) : string;
  30.  
  31. {***************************************************************}
  32. {* Center_Str   centers the characters in the string based     *}
  33. {*              upon the size/midpoint specified.              *}
  34. {***************************************************************}
  35. FUNCTION Center_Str (Str : string; Output_Size : integer) : string;
  36.  
  37. {**************************************************************}
  38. {* Change_Case changes the case of the string to UPPER.       *}
  39. {*                                                            *}
  40. {**************************************************************}
  41. FUNCTION CHANGE_CASE (Str : string) : string;
  42. FUNCTION Lower_Case (Str : string) : string;
  43.  
  44. {**************************************************************}
  45. {* Int_To_Str returns the number converted into ascii chars.  *}
  46. {*                                                            *}
  47. {**************************************************************}
  48. FUNCTION Int_To_Str  (Num : LongInt) : string;
  49. FUNCTION Int_To_Str_Zero_Fill  (Num : LongInt; Fill : byte) : string;
  50. FUNCTION Int_Num_Digits (Num : LongInt) : integer;
  51.  
  52. {**************************************************************}
  53. {* Pos_Reverse returns the last occurance of the string       *}
  54. {*     just before the specified start pos!                   *}
  55. {**************************************************************}
  56. FUNCTION Pos_Reverse (Str        : string;
  57.                       Delimiter  : string;
  58.                       Start_At   : integer) : integer;
  59.  
  60. {**************************************************************}
  61. {* Find_Char   returns the position of the char               *}
  62. {*                                                            *}
  63. {**************************************************************}
  64. FUNCTION Find_Char   (Str      : string;
  65.                       Char_Is  : char;
  66.                       Start_At : integer) : INTEGER;
  67.  
  68. {**************************************************************}
  69. {* Delete_The_Char   delete all occurances of the char        *}
  70. {*                                                            *}
  71. {**************************************************************}
  72. FUNCTION Delete_The_Char
  73.                      (Str      : string;
  74.                       Char_Is  : char) : string;
  75.  
  76. {**************************************************************}
  77. {* Replace_Str_Into  inserts the small string into the        *}
  78. {*                   org_str at the position specified        *}
  79. {**************************************************************}
  80. FUNCTION Replace_Str_Into (Org_Str     : String;
  81.                            Small_Str   : string;
  82.                            Start, Stop : integer) : string;
  83.  
  84. {**************************************************************}
  85. {* procedure Get_Word_Around_Position                         *}
  86. {*     returns the word based AROUND the position specified   *}
  87. {*     Searches for blanks around the start_pos               *}
  88. {*        looking left then right.                            *}
  89. {**************************************************************}
  90. function Get_Word_Around_Position
  91.                      (Str                    : string;
  92.                       Start_Pos              : integer;
  93.                       Leftmost_Char_Boundry  : integer;
  94.                       Rightmost_Char_Boundry : integer;
  95.                       VAR Found_Left_Pos     : integer;
  96.                       VAR Found_Word_Size    : integer) : string;
  97.  
  98. {**************************************************************}
  99. {* returns a string with duplicate chars deleted.             *}
  100. {**************************************************************}
  101. function Delete_Duplicate_Chars_In_Str (Str            : string;
  102.                                         Limit_In_A_Row : byte): string;
  103.  
  104. {**************************************************************}
  105. {* returns a string filled with the character specified       *}
  106. {**************************************************************}
  107. function Fill_String(Len : Byte; Ch : Char) : String;
  108.  
  109. {**************************************************************}
  110. {* Truncates a string to a specified length                   *}
  111. {**************************************************************}
  112. function Trunc_Str(TString : String; Len : Byte) : String;
  113.  
  114. {**************************************************************}
  115. {* Pads a string to a specified length with a specified character }
  116. {**************************************************************}
  117. function Pad_Char(PString : String; Ch : Char; Len : Byte) : String;
  118.  
  119.  
  120. {**************************************************************}
  121. {* Left-justify a string within a certain width               *}
  122. {**************************************************************}
  123. function Left_Justify_Str (S : String; Width : Byte) : String;
  124.  
  125.  
  126. {**************************************************************}
  127. {* Note that "Count" is the number of *WORDS* to fill.        *}
  128. {* So e.g. you'd use                                          *}
  129. {* "FillWord(My_Int_Array, SizeOf(My_Int_Array) DIV 2, 1);"   *}
  130. {*      by Neil Rubenking                                     *}
  131. {**************************************************************}
  132. PROCEDURE FillWord (VAR Dest; Count, What : Word);
  133.  
  134.  
  135. {**************************************************************}
  136. {**************************************************************}
  137. {**************************************************************}
  138. IMPLEMENTATION
  139.  
  140. {**************************************************************************}
  141. function Min(N1, N2 : Longint) : Longint;
  142. { Returns the smaller of two numbers }
  143. begin
  144.   if N1 <= N2 then
  145.     Min := N1
  146.   else
  147.     Min := N2;
  148. end; { Min }
  149.  
  150. (*
  151. {**************************************************************************}
  152. function Max(N1, N2 : Longint) : Longint;
  153. { Returns the larger of two numbers }
  154. begin
  155.   if N1 >= N2 then
  156.     Max := N1
  157.   else
  158.     Max := N2;
  159. end; { Max }
  160. *)
  161.  
  162. {**************************************************************}
  163. {* returns a string filled with the character specified       *}
  164. {**************************************************************}
  165. function Fill_String(Len : Byte; Ch : Char) : String;
  166. var
  167.   S : String;
  168. begin
  169.   IF (Len > 0) THEN
  170.     BEGIN
  171.       S[0] := Chr(Len);
  172.       FillChar(S[1], Len, Ch);
  173.       Fill_String := S;
  174.     END
  175.   ELSE Fill_String := '';
  176. end; { FillString }
  177.  
  178. {**************************************************************}
  179. {* Truncates a string to a specified length                   *}
  180. {**************************************************************}
  181. function Trunc_Str(TString : String; Len : Byte) : String;
  182. begin
  183.   if (Length(TString) > Len) then
  184.     begin
  185.       {Delete(TString, Succ(Len), Length(TString) - Len);}
  186.       {Move(TString[Succ(Len)+(LENGTH(TString)-Len)], TString[Succ(Len)],
  187.            Succ(Length(TString)) - Succ(Len) - Length(TString) - Len));}
  188.       Move(TString[LENGTH(TString)+1], TString[Succ(Len)], 2*Len);
  189.       Dec(TString[0], Length(TString) - Len);
  190.     end;
  191.   Str_Stf.Trunc_Str := TString;
  192. end; { TruncStr }
  193.  
  194. {**************************************************************}
  195. {* Pads a string to a specified length with a specified character }
  196. {**************************************************************}
  197. function Pad_Char(PString : String; Ch : Char; Len : Byte) : String;
  198. var
  199.   CurrLen : Byte;
  200. begin
  201.   CurrLen := Min(Length(PString), Len);
  202.   PString[0] := Chr(Len);
  203.   FillChar(PString[Succ(CurrLen)], Len - CurrLen, Ch);
  204.   Pad_Char := PString;
  205. end; { PadChar }
  206.  
  207. {**************************************************************}
  208. {* Left-justify a string within a certain width               *}
  209. {**************************************************************}
  210. function Left_Justify_Str(S : String; Width : Byte) : String;
  211. begin
  212.   Left_Justify_Str := Str_Stf.Pad_Char(S, ' ', Width);
  213. end; { Left_Justify_Str }
  214.  
  215. {**************************************************************}
  216. {* Trim   removes leading/trailing blanks.                    *}
  217. {*                                                            *}
  218. {**************************************************************}
  219. FUNCTION TRIM (Str : string) : string;
  220. VAR
  221.   i : integer;
  222. BEGIN
  223.   i := 1;
  224.   WHILE ((i < LENGTH(Str)) and (Str[i] = ' '))
  225.     DO INC(i);
  226.  
  227.   IF (i > 1) THEN
  228.     BEGIN
  229.       {Str := COPY (Str, i, Length(Str));}
  230.       Move (Str[i], Str[1], Succ(LENGTH(Str))-i);
  231.       DEC (Str[0], pred(i));
  232.     END;
  233.  
  234.   WHILE (Str[LENGTH(str)] = ' ')
  235.     DO DEC (Str[0]);
  236.  
  237.   Trim := Str;
  238. END;  {trim}
  239.  
  240. {**************************************************************}
  241. {* Trim_Lead   removes leading blanks.                        *}
  242. {*                                                            *}
  243. {**************************************************************}
  244. FUNCTION TRIM_Leading_Only (Str : string) : string;
  245. VAR
  246.   i : integer;
  247. BEGIN
  248.   i := 1;
  249.   WHILE ((i < LENGTH(Str)) and (Str[i] = ' '))
  250.     DO INC(i);
  251.  
  252.   IF (i > 1) THEN
  253.     BEGIN
  254.       {Str := COPY (Str, i, Length(Str));}
  255.       Move (Str[i], Str[1], Succ(LENGTH(Str))-i);
  256.       DEC (Str[0], pred(i));
  257.     END;
  258.  
  259.   Trim_Leading_Only := Str;
  260. END;  {trim_leading_Only}
  261.  
  262. {***************************************************************}
  263. FUNCTION TRIM_Trailing_Only (Str : string) : string;
  264. BEGIN
  265.   WHILE (Str[LENGTH(str)] = ' ')
  266.     DO DEC (Str[0]);
  267.  
  268.   Trim_Trailing_Only := Str;
  269. END;  {trim}
  270.  
  271. {***************************************************************}
  272. {*------------------------------------------------------*}
  273. {* Trim off any lead/trail quotes!                      *}
  274. {*------------------------------------------------------*}
  275. FUNCTION TRIM_Quotes (Str : string) : string;
  276. begin
  277.   IF ((LENGTH(Str) > 0) and (Str[1] = '"')) THEN
  278.     BEGIN
  279.       Move (Str[2], Str[1], pred(LENGTH(Str)));
  280.       DEC (Str[0]);
  281.       IF (Str[LENGTH(Str)] = '"')
  282.         THEN DEC(Str[0]);
  283.     END; {if}
  284. Trim_Quotes := Str;
  285. end; {Trim_Quotes}
  286.  
  287. {***************************************************************}
  288. {* Right_Justify adds leading blanks.                          *}
  289. {*    NOTE: does not handle cases when                         *}
  290. {*                    Size_To_Be < ACTUAL NUMBER OF CHARACTERS *}
  291. {***************************************************************}
  292. FUNCTION Right_Justify (Str : string; Size_To_Be : integer) : string;
  293. VAR
  294.   Temp_Str  : string;
  295. BEGIN
  296.   Temp_Str := TRIM (Str);   {to assure proper length--and NON-BLANK}
  297.   Right_Justify := Str_Stf.Left_Justify_Str
  298.                                ('', Size_To_Be - Length(Str)) + Str;
  299.  
  300. {  WHILE ((LENGTH(Temp_Str) > 0) AND
  301.          ( (Size_To_Be > LENGTH (Temp_Str)) OR
  302.            (Temp_Str[Size_To_Be] = ' ') ) )
  303.     DO Temp_Str := ' '+ COPY (Temp_Str, 1, Size_To_Be-1);
  304.   Right_Justify := Temp_Str;}
  305.  
  306. END; {right_justify}
  307.  
  308. {***************************************************************}
  309. {* Center_Str   centers the characters in the string based     *}
  310. {*              upon the size/midpoint specified.              *}
  311. {***************************************************************}
  312. FUNCTION Center_Str (Str : string; Output_Size : integer) : string;
  313. VAR
  314.   Ret_Str : string;
  315.   Size    : integer;
  316. BEGIN
  317.   { blank out returning string}
  318.   Ret_Str := Str_Stf.Fill_String(Output_Size, ' ');
  319.   {FillChar (Ret_Str, output_size, ' ');
  320.    Ret_Str[0] := chr(Output_Size);}
  321.  
  322.   Str := TRIM (Str);
  323.   Size := LENGTH (Str);
  324.   IF (Output_Size <= Size)
  325.     THEN Ret_Str := Str
  326.   ELSE
  327.     BEGIN
  328.       Insert (Str, Ret_Str, (((Output_Size - Size) div 2)+1));
  329.       Ret_Str := COPY (Ret_Str, 1, OutPut_Size);
  330.     END;
  331.   Center_Str := Ret_Str;
  332. END; {center_str}
  333.  
  334. {**************************************************************}
  335. {* Change_Case changes the case of the string to UPPER.       *}
  336. {*                                                            *}
  337. {**************************************************************}
  338. FUNCTION Change_Case (Str : string) : string;
  339. var
  340.   i : integer;
  341. BEGIN
  342.   for i := 1 to LENGTH (Str)
  343.     do Str[i] := UpCase(Str[i]);
  344.   Change_Case := Str;
  345. END;  {change_case}
  346.  
  347. {**************************************************************}
  348. FUNCTION Lower_Case (Str : string) : string;
  349. var
  350.   i : integer;
  351. BEGIN
  352.   for i := 1 to LENGTH (Str)
  353.     do IF ((ORD (Str[i]) >= 65) and (ORD(Str[i]) <= 90))
  354.          THEN Str[i] := CHR(ORD(Str[i])+32);
  355.   Lower_Case := Str;
  356. END;  {lower_case}
  357.  
  358. {**************************************************************}
  359. {* Int_To_Str returns the number converted into ascii chars.  *}
  360. {*                                                            *}
  361. {**************************************************************}
  362. FUNCTION Int_To_Str  (Num : LongInt) : string;
  363. var
  364.   Temp_Str : string;
  365. BEGIN
  366.   STR(Num, Temp_Str);
  367.   Int_To_Str := Temp_Str;
  368. END; {int_to_str}
  369.  
  370. FUNCTION Int_To_Str_Zero_Fill  (Num : LongInt; Fill : byte) : string;
  371. var
  372.   Temp_Str : string;
  373.   Len : byte;
  374. BEGIN
  375.   STR(Num, Temp_Str);
  376.   Len := LENGTH(Temp_Str);
  377.   IF (Len < Fill)
  378.     THEN Temp_Str := Fill_String(Fill-Len, '0')+Temp_Str;
  379.   Int_To_Str_Zero_Fill := Temp_Str;
  380. END; {int_to_str_zero_fill}
  381.  
  382. FUNCTION Int_Num_Digits (Num : LongInt) : integer;
  383. var
  384.  Tens, Digits : Integer;
  385. BEGIN
  386.   IF (Num = 0)
  387.     THEN Int_Num_Digits := 1
  388.   ELSE
  389.     BEGIN
  390.       Tens := 1;
  391.       Digits := 1;
  392.       WHILE ((Num DIV Tens) <> 0) DO
  393.       BEGIN
  394.         INC (Digits);
  395.         Tens := Tens * 10;
  396.       END; {while}
  397.  
  398.       IF (Digits > 1)
  399.         THEN DEC (Digits);
  400.       Int_Num_Digits := Digits;
  401.     END; {if}
  402.  
  403. END; {int_num_digits}
  404.  
  405. {**************************************************************}
  406. {* Pos_Reverse returns the last occurance of the string       *}
  407. {*     just before the specified start pos!                   *}
  408. {**************************************************************}
  409. FUNCTION Pos_Reverse (Str        : string;
  410.                       Delimiter  : string;
  411.                       Start_At   : integer) : integer;
  412. VAR
  413.   Temp_Str : string;
  414.   Found_Pos, Found_Pos_0 : integer;
  415. BEGIN
  416.   Temp_Str := COPY(Str, 1, Start_At);  {dont use move since ?start_at <length?}
  417.   Found_Pos_0 := 0;
  418.   REPEAT
  419.     Found_Pos := POS (Delimiter, Temp_Str);
  420.     IF (Found_Pos <> 0) THEN
  421.       BEGIN
  422.         Found_Pos_0 := Found_Pos_0+Found_Pos;
  423.         {Temp_Str := COPY(Temp_Str, Found_Pos+1, LENGTH(Temp_Str));}
  424.         Move (Temp_Str[Found_Pos+1], Temp_Str[1], LENGTH(Str)-Found_Pos+2);
  425.         DEC (Temp_Str[0], Found_Pos);
  426.       END;
  427.   UNTIL (Found_Pos = 0);
  428.   Pos_Reverse := Found_Pos_0;
  429. END; {pos_reverse}
  430.  
  431. {**************************************************************}
  432. {* Find_Char   returns the position of the char               *}
  433. {*                                                            *}
  434. {**************************************************************}
  435. FUNCTION Find_Char (Str      : string;
  436.                     Char_Is  : char;
  437.                     Start_At : integer) : INTEGER;
  438. VAR
  439.   Loc : integer;
  440. BEGIN
  441.   Loc := POS (Char_Is, COPY(Str, Start_At, LENGTH(STR)));
  442.   IF (Loc <> 0)
  443.     THEN Loc := Loc + Start_At -1;
  444.   Find_Char := Loc;
  445. END; {function Find_Char}
  446.  
  447. {**************************************************************}
  448. {* Delete_The_Char   delete all occurances of the char        *}
  449. {*                                                            *}
  450. {**************************************************************}
  451. FUNCTION Delete_The_Char (Str      : string;
  452.                           Char_Is  : char) : string;
  453. VAR
  454.   Loc : integer;
  455. BEGIN
  456.   Loc := 0;
  457.   REPEAT
  458.     Loc := POS (Char_Is, Str);
  459.     IF (Loc <> 0) THEN
  460.       BEGIN
  461.         {DELETE (Str, Loc, 1);}
  462.         Move(Str[Succ(Loc)], Str[Loc], Length(Str)-Loc);
  463.         Dec(Str[0]);
  464.       END;
  465.   UNTIL (Loc = 0);
  466.  
  467.   Delete_The_Char := STR;
  468. END; {function Delete_The_Char}
  469.  
  470. {**************************************************************}
  471. {* Replace_Str_Into  inserts the small string into the        *}
  472. {*                   org_str at the position specified        *}
  473. {**************************************************************}
  474. FUNCTION Replace_Str_Into (Org_Str     : String;
  475.                            Small_Str   : string;
  476.                            Start, Stop : integer) : string;
  477. var
  478.   Temp_Small_Str : string;
  479. begin
  480.   IF (Start = 0)
  481.     THEN Start := 1;
  482.  
  483.   IF (LENGTH(Small_Str) >= (Stop-Start+1))
  484.     THEN Temp_Small_Str := Small_Str
  485.   ELSE Temp_Small_Str := Small_Str +
  486.                        Fill_String ( (Stop-Start+1-LENGTH(Small_Str)), ' ');
  487.   IF (Start > 1)
  488.     THEN Replace_Str_Into := Copy (Org_Str, 1, (Start -1)) +
  489.                              Copy (Temp_Small_Str, 1, (Stop-Start+1))+
  490.                              Copy (Org_Str, (Stop+1) , LENGTH(Org_Str))
  491.     ELSE Replace_Str_Into := Copy (Temp_Small_Str, 1, (Stop-Start+1)) +
  492.                              Copy (Org_Str, Stop+1, LENGTH(Org_Str));
  493. end; {Replace_Str_into}
  494.  
  495. {**************************************************************}
  496. {* procedure Get_Word_Around_Position                         *}
  497. {*     returns the word based AROUND the position specified   *}
  498. {*     Searches for blanks around the start_pos               *}
  499. {*        looking left then right.                            *}
  500. {**************************************************************}
  501. function Get_Word_Around_Position
  502.                                (Str                    : string;
  503.                                 Start_Pos              : integer;
  504.                                 Leftmost_Char_Boundry  : integer;
  505.                                 Rightmost_Char_Boundry : integer;
  506.                                 VAR Found_Left_Pos     : integer;
  507.                                 VAR Found_Word_Size    : integer) : string;
  508. var
  509.   adjust         : integer;
  510.  
  511. begin
  512.   IF ((Start_Pos <= LENGTH(Str))) THEN
  513.     BEGIN
  514.       Get_Word_Around_Position := Str[Start_Pos];
  515.       Found_Left_Pos := Start_Pos;
  516.       Found_Word_Size := 1;
  517.     END
  518.  
  519.   ELSE        {* Bad Params! *}
  520.     BEGIN
  521.       Get_Word_Around_Position := ' ';
  522.       Found_Left_Pos           := 0;
  523.       Found_Word_Size          := 0;
  524.       Exit;
  525.     END;
  526.  
  527.   if (Str[Start_Pos] <> ' ') then
  528.     begin
  529.       {************************************************}
  530.       {*  FIRST: find left-most position              *}
  531.       {************************************************}
  532.       adjust := Start_Pos -1;
  533.       while ((adjust >= leftmost_char_boundry) and
  534.              (Str[adjust] <> ' '))
  535.         do adjust := adjust - 1;
  536.       if ((adjust = leftmost_char_boundry) and (Str[adjust] <> ' '))
  537.         then Found_Left_Pos := adjust
  538.         else Found_Left_Pos := adjust +1;
  539.  
  540.       {************************************************}
  541.       {*  find right-most position                    *}
  542.       {************************************************}
  543.       adjust := Start_Pos +1;
  544.       while ((adjust <= Rightmost_Char_Boundry) and
  545.               (Str[adjust] <> ' '))
  546.         do adjust := adjust + 1;
  547.  
  548.       if ((adjust = Rightmost_char_boundry) and (Str[adjust] <> ' '))
  549.         then Found_Word_Size := adjust - Found_Left_Pos +1
  550.         else Found_Word_Size := adjust - Found_Left_Pos;
  551.  
  552.       Get_Word_Around_Position := Copy (Str, Found_Left_Pos, Found_Word_Size);
  553.  
  554.     end; {if}
  555.  
  556. end; {get_word_around_position}
  557.  
  558. {**************************************************************}
  559. {* returns a string with duplicate chars deleted.             *}
  560. {**************************************************************}
  561. function Delete_Duplicate_Chars_In_Str (Str            : string;
  562.                                         Limit_In_A_Row : byte) : string;
  563. var
  564.   Curr_Pos       : integer;
  565.   i              : integer;
  566.   Same_Chars     : boolean;
  567. begin
  568.  
  569.   IF (Limit_In_A_Row = 1) THEN       {* must catch or infinite loop *}
  570.     BEGIN
  571.       Delete_Duplicate_Chars_In_Str := '';
  572.       exit;
  573.     END;
  574.  
  575.   Curr_Pos        := 1;
  576.   WHILE ((Curr_Pos+Limit_In_A_Row-1) <= LENGTH(Str)) DO
  577.     BEGIN
  578.  
  579.       {*---------------------------------------*}
  580.       {* Quickly look for at least 2 in a row! *}
  581.       {*---------------------------------------*}
  582.       WHILE (((Curr_Pos+Limit_In_A_Row-1) <= LENGTH(Str)) AND
  583.              (Str[Curr_Pos] <> Str[Succ(Curr_Pos)]))
  584.         DO INC(Curr_Pos);
  585.  
  586.       IF ((Curr_Pos+Limit_In_A_Row-1) <= LENGTH(Str)) THEN
  587.         BEGIN
  588.           i := Curr_Pos+1;
  589.           Same_Chars := TRUE;
  590.           WHILE ((Same_Chars) and (i <= (Curr_Pos+Limit_In_A_Row-1)))
  591.             DO IF (Str[Curr_Pos] <> Str[i])
  592.                  THEN Same_Chars := FALSE
  593.                  ELSE INC(i);
  594.  
  595.           IF (Same_Chars) THEN
  596.             BEGIN
  597.               Move(Str[Curr_Pos+Limit_In_A_Row-1], Str[Curr_Pos],
  598.                                 Length(Str)-(Curr_Pos+Limit_In_A_Row-2));
  599.               Dec(Str[0],Pred(Limit_In_A_Row));
  600.             END
  601.           ELSE Inc(Curr_Pos);
  602.         END; {if}
  603.     END; {while}
  604.  
  605.   Delete_Duplicate_Chars_In_Str := Str;
  606. end; {delete_duplicate_chars_in_str}
  607.  
  608. {*
  609.        Note that "Count" is the number of *WORDS* to fill.  So e.g. you'd
  610. use "FillWord(My_Int_Array, SizeOf(My_Int_Array) DIV 2, 1);"
  611.       by Neil Rubenking *}
  612. {**************************************************************}
  613. PROCEDURE FillWord(VAR Dest; Count, What : Word); Assembler;
  614.   ASM
  615.     LES DI, Dest    {ES:DI points to destination}
  616.     MOV CX, Count   {count in CX}
  617.     MOV AX, What    {word to fill with in AX}
  618.     CLD             {forward direction}
  619.     REP STOSW       {perform the fill}
  620.   END; {fillWord}
  621.  
  622. END. {unit str_stf}